FAIRE DES CARTES DE FLUX DANS R
Lorem Ipsum is simply dummy text of the printing and typesetting industry. Lorem Ipsum has been the industry’s standard dummy text ever since the 1500s, when an unknown printer took a galley of type and scrambled it to make a type specimen book. It has survived not only five centuries, but also the leap into electronic typesetting, remaining essentially unchanged. It was popularised in the 1960s with the release of Letraset sheets containing Lorem Ipsum passages, and more recently with desktop publishing software like Aldus PageMaker including versions of Lorem Ipsum.
Les données
Jeu de données sur les migrations internationales. Migration Stock at subregional level, 2019 Source : United Nations, Department of Economic and Social Affairs, Population Division (2019). Voir
Les packages
install.packages("sf")
install.packages("remotes")
library(remotes)
install_github("riatelab/mapsf")
install_github("tributetotobler/ttt")library("sf")
library("mapsf")
library("ttt")Import et mise en forme des données
countries <- st_read("data/world/geom/countries.gpkg")
subregions <- st_read("data/world/geom/subregions.gpkg")
graticule <- st_read("data/world/geom/graticule.gpkg")
bbox <- st_read("data/world/geom/bbox.gpkg")
migr <- read.csv("data/world/fij/migr2019_T.csv")
crs <- "+proj=aeqd +lat_0=90 +lon_0=50 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs "
countries <- st_transform(x = countries, crs = crs)
subregions <- st_transform(x = subregions, crs = crs)
graticule <- st_transform(x = graticule, crs = crs)
bbox <- st_transform(x = bbox, crs = crs)
land <- st_union(countries)Template cartographique
col = "#ffc524"
credit = paste0("Françoise Bahoken & Nicolas Lambert, 2021\n",
"Source: United Nations, Department of Economic\n",
"and Social Affairs, Population Division (2019)")
# theme = mf_theme(x = "default", bg = "white", tab = FALSE,
# pos = "center", line = 2, inner = FALSE,
# fg = "#9F204270", mar = c(0,0, 2, 0),cex = 1.9)
theme <- mf_theme(
x = "default",
bg = "#3b3b3b",
fg = "#ffc524",
mar = c(0,0, 2, 0),
tab = TRUE,
pos = "left",
inner = TRUE,
line = 2,
cex = 1.9,
font = 3
)
template = function(title, file){
mf_export(
countries,
export = "png",
width = 1000,
filename = file,
res = 96,
theme = theme,
expandBB = c(-.02,0,-.02,0)
)
mf_map(bbox, col = "#3b3b3b",border = NA, lwd = 0.5, add = TRUE)
mf_map(graticule, col = "#FFFFFF50", lwd = 0.5, add = TRUE)
mf_map(countries, col = "#4e4f4f",border = "#3b3b3b", lwd = 0.5, add = TRUE)
# mf_map(links, col = NA,border = "#317691", lwd = 0.5, add = TRUE)
mf_credits(
txt = credit,
pos = "bottomright",
col = "#1a2640",
cex = 0.7,
font = 3,
bg = "#ffffff30"
)
mf_title(title)
}template("Template cartographique", "maps/template.png")
dev.off()
L’effet Spaghetti
links <- mf_get_links(x = countries, df = migr, x_id = "adm0_a3_is", df_id = c("i", "j"))template("L'effet Spaghetti ", "maps/spaghetti.png")
mf_map(links, col = col, add=TRUE)
mf_map(land, col = NA, border = "#3b3b3b", add=TRUE)
dev.off()
Répondre à des questions simples
knitr::kable(migr[c(0:10),], row.names = F, digits = 1)| i | j | fij |
|---|---|---|
| PAK | AFG | 106528 |
| TJK | AFG | 4596 |
| UZB | AFG | 229 |
| CAN | ALB | 856 |
| GRC | ALB | 29852 |
| ITA | ALB | 8405 |
| MKD | ALB | 504 |
| TUR | ALB | 1852 |
| USA | ALB | 2242 |
| FRA | DZA | 551 |
Question 1 : Combien y a t-il de migrants dans le monde en 2019 ?
paste0(sum(migr$fij) / 1000000, " millions")## [1] "260.283744 millions"Question 2 : …
Prendre le prisme d’un seul pays
Origine des migrants vivant en Afrique du Sud
Choix d’un pays
ISO3 <- "FRA"
label = "France"Jointure et mise ne forme des données
countr <- countries[,c("adm0_a3_is","label")]
migr <- migr[migr$j == ISO3,]
tot <- sum(migr$fij)
migr <- rbind.data.frame(migr, c(i = ISO3,j = ISO3,fij = tot))
migr$fij <- as.numeric(migr$fij)
countr <- merge(x = countr,y = migr, by.x = "adm0_a3_is", by.y = "i", all.x = TRUE)
countr <- countr[-3]
colnames(countr) <- c("id","label","fij","geometry")knitr::kable(countr[c(0:10),], row.names = F, digits = 1)| id | label | fij | geometry |
|---|---|---|---|
| ABW | Aruba | 11 | MULTIPOLYGON (((-7476945 42… |
| AFG | Afghanistan | 6887 | MULTIPOLYGON (((2474775 -53… |
| AGO | Angola | 23438 | MULTIPOLYGON (((-4917506 -1… |
| AIA | Anguilla | 10 | MULTIPOLYGON (((-7351488 31… |
| ALB | Albania | 7371 | MULTIPOLYGON (((-2639654 -4… |
| AND | Andorra | 1079 | MULTIPOLYGON (((-3952645 -3… |
| ARE | United Arab Emirates | 862 | MULTIPOLYGON (((785851 -712… |
| ARG | Argentina | 14253 | MULTIPOLYGON (((-14113355 7… |
| ARM | Armenia | 21012 | MULTIPOLYGON (((-348529.3 -… |
| ASM | American Samoa | 1 | MULTIPOLYGON (((7561304 878… |
Une premiere carte simple
template(paste0("Origine des personnes migrantes vivant en ",label," en 2019"), "maps/prop1.png")
#mf_map(countr[countr$id == ISO3,], col = col, border = "red", lwd = 2, add = TRUE)
mf_map(countr[countr$id != ISO3,], var = "fij", col = col, border = "white", type = "prop",
inches = 0.3, leg_title_cex = 1.2, leg_val_cex = 0.8, leg_pos = "bottomleft",
leg_title = "Nombre de personnes")
mf_map(countr[countr$id == ISO3,], col = NA, border = "#e36019", lwd = 2, add = TRUE)
dev.off()
Même information avec des lignes
countr$dist = ISO3
links <- mf_get_links(x = countr, df = data.frame(countr), x_id = "id", df_id = c("id", "dist"))
links = links[links$id != ISO3,]template(paste0("Origine des personnes migrantes vivant en ",label," en 2019"), "maps/flows1.png")
mf_map(links, var = "fij", col = col, type = "prop",
inches = 4, leg_title_cex = 1.2, leg_val_cex = 0.8,
leg_title = "Nombre de personnes")
mf_map(countr[countr$id == ISO3,], col = NA, border = "#e36019", lwd = 2, add = TRUE)
dev.off()
Une carte un peu plus sophistiquée
Flowmapper
flowmapper() est une fonction du package ttt (en cours de développement).
library(ttt)La fonction ttt_flowmapper() prends plusieurs arguements :
…
Les données
migr <- read.csv("data/world/subregions/migrantstocks2019.csv")
threshold <- 1500
migr <- migr[migr$fij >= threshold,]knitr::kable(migr[c(0:10),], row.names = F, digits = 1)| i | j | fij |
|---|---|---|
| 5500 | 923 | 5603 |
| 5501 | 5501 | 11177 |
| 5501 | 918 | 5334 |
| 5501 | 920 | 1666 |
| 5501 | 922 | 18402 |
| 5501 | 924 | 2551 |
| 906 | 906 | 5202 |
| 906 | 918 | 5700 |
| 910 | 910 | 5330 |
| 910 | 913 | 1538 |
flows <- ttt_flowmapper(
x = subregions,
xid = "id",
df = migr,
dfid = c("i","j"),
dfvar = "fij",
plot = FALSE
)$inks
template("ttt_flowmapper$links", "maps/ttt_links.png")
mf_map(subregions, col = "#4e4f4f",border = "#3b3b3b", lwd = 0.5, add = TRUE)
mf_map(flows$links, col = col, lwd = 3, add = TRUE)
dev.off()
$circles
template("ttt_flowmapper$circles", "maps/ttt_circles.png")
mf_map(subregions, col = "#4e4f4f",border = "#3b3b3b", lwd = 0.5, add = TRUE)
mf_map(flows$circles, col = col, add = TRUE)
dev.off()
$fleches
template("ttt_flowmapper$flows", "maps/ttt_flows.png")
mf_map(subregions, col = "#4e4f4f",border = "#3b3b3b", lwd = 0.5, add = TRUE)
mf_map(flows$flows, col = col, add = TRUE)
dev.off()Visualisation par défaut
template("ttt_flowmapper$flows", "maps/ttt_flows.png")
mf_map(subregions, col = "#4e4f4f",border = "#3b3b3b", lwd = 0.5, add = TRUE)
ttt_flowmapper(
x = subregions,
xid = "id",
type = "arrows",
df = migr,
dfid = c("i","j"),
dfvar = "fij",
col = col,
border = "#424242",
border2 = col,
add=TRUE
)
dev.off()
La VV taille, c’est aussi la surface
template("La surface des fleches", "maps/ttt_surface.png")
mf_map(subregions, col = "#4e4f4f",border = "#3b3b3b", lwd = 0.5, add = TRUE)
ttt_flowmapper(
x = subregions,
xid = "id",
type = "arrows",
size = "area",
df = migr,
dfid = c("i","j"),
dfvar = "fij",
col = col,
border = "#424242",
border2 = col,
add=TRUE
)
dev.off()
Epaisseur vs Surface
Interactions (type = “rect”)
migr2 <- data.frame(i = integer(),j= integer(),fij = integer())
for (k in 1:length(migr$i)){
val1 <- migr$fij[k]
val2 <- migr[migr$i == migr$j[k] & migr$j == migr$i[k],"fij"]
val <- sum(val1,val2)
idi = migr$i[k]
idj = migr$j[k]
test <- length(migr2[(migr2$i == idi & migr2$j == idj) | (migr2$i == idj & migr2$j == idi),"fij"])
if (test == 0){migr2 <- rbind(migr2, data.frame(i = idi, j = idj, fij = val))}
}
migr2 <- migr2[migr2$i != migr2$j,] head(migr2)## i j fij
## 1 5500 923 9999
## 3 5501 918 5334
## 4 5501 920 3221
## 5 5501 922 18402
## 6 5501 924 2551
## 8 906 918 5700template("tInteractions", "maps/ttt_interactions.png")
c <- ttt_flowmapper(
x = subregions,
xid = "id",
size = "thickness",
type = "rect",
df = migr2,
dfid = c("i","j"),
dfvar = "fij",
col = col,
border = "#424242",
border2 = col,
add=TRUE
)
dev.off()
Combiner flux intra et flux inter
intra <- migr[migr$i == migr$j,]
intra <- intra[,c("i","fij")]
colnames(intra) <- c("id","nb")
knitr::kable(intra, row.names = F, digits = 1)template("Flux inter et flux intra", "maps/interintra.png")
flows <- ttt_flowmapper(
x = subregions,
xid = "id",
df = migr,
dfid = c("i","j"),
dfvar = "fij",
size = "thickness",
type = "arrows",
decreasing = FALSE,
add = TRUE,
lwd = 1,
col = col,
border = "#424242",
k = NULL,
k2 = 60,
df2 = intra,
df2id = "id",
df2var = "nb",
col2 = col,
border2 = "#424242"
)
dev.off()